Amiga Plus Special 16/AMIGAplus Sonderheft 16 (1998)(ICP)(DE)[!].iso/pd/anwendungen/amicad/arexx_english/savenets.amicad

Text File | 1998-08-09 | 8KB | 360 lines

/* $VER: SaveNets 1.00e (© R.Florac, 09-08-98) */

options results

signal on error
signal on syntax

j=1; nets=1;
'DEF NEXTJUNCTION(O)=OO=O:WHILE(IF(OO>0,TYPE(OO)<>7,0),IF(OO<OBJECTS(-1),OO=OO+1,OO=0)):OO'
'UNMARK(-1):LOCK(-1):OBJECTS(-1)'; objets=result

equi.=-1
label.=""

'TITLE("Reading labels...")'
do i=1 to objets
    'TYPE(O='i')'
    if result=4 | result=12 | result=11 then do
    'ABS(FINDLINE(1,COL(O),LINE(O)))'; j=result
    if j>0 then do
        'READTEXT(O)'; label=result
        if datatype(label,"w") then label.label="LABEL_DÉJÀ_UTILISÉ"
    end
    end
end

'TITLE("Testing nets...")'
i=1
do while i>0
    'OO=FINDOBJ('i',2,-1,-1)'; i=result
    if result>0 then do
    'TEST(OO)'
    if result=0 then do
        do while label.nets~=""
        nets=nets+1
        end
        label.nets=nets
        equi.i=nets
        'COORDS(OO)'
        parse var result x0','y0','x1','y1
        call test_ligne(x0,y0,nets,objets)
        call test_ligne(x1,y1,nets,objets)
    end
    if i=objets then i=0
    else i=i+1
    end
end

'TITLE("Testing junctions...")'
i=1
do while i>0
    'I=FINDOBJ('i',7,-1,-1)'; i=result
    if i>0 then do
    'MARK(I):L1=ABS(FINDLINE(1,COL(I),LINE(I)))'; l1=result
    if l1>0 & l1<objets then do
        j=l1+1
        do while j>0
        'J=ABS(FINDLINE('j',COL(I),LINE(I)))'; j=result
        if j>0 then do
            if equi.j~=equi.l1 then do
            call changer_labels(l1,j)
            end
            if j=objets then j=0
            else j=j+1
        end
        end
    end
    if i=objets then i=0
    else i=i+1
    end
end

'TITLE("Looking for labels and connectors...")'
do i=1 to objets
    'TYPE(O='i')'
    if result=4 | result=12 | result=11 then do
    'ABS(FINDLINE(1,COL(O),LINE(O)))'; j=result
    if j>0 then do
        net=equi.j
        'READTEXT(O)'; label=result
        label.net=label
    end
    end
end

'TITLE("Looking for powers...")'
do i=1 to objets
    'FINDPART('i',"POWER SUPPLY")'; i=result
    if i>0 then do
    j=connexion_broche(i,1)
    if j>0 then do
        net=equi.j
        'READTEXT(GETVAL('i'))'; label=result
        label.net=label
    end
    end
    else leave
end

'TITLE("Testing redundances...")'
do i=1 to nets
    do j=i+1 to nets
    if label.j~="" then do
        if label.i=label.j then do
        do k=1 to objets
            if equi.k=j then equi.k=i
        end
        label.j=""
        end
    end
    end
end

'TITLE("Looking for grounds...")'
do i=1 to objets
    'FINDPART('i',"GROUND")'; i=result
    if i>0 then do
    j=connexion_broche(i,1)
    if j>0 then do
        equi.0=0; label.0=0
        call changer_labels(0,j)
    end
    end
    else leave
end

do until c=0
    'TITLE("Setting netlist ended"):SELECT("Choose an action"+CHR(10)+"Look for nets"+CHR(10)+"Check netlist"+CHR(10)+"Save netlist"+CHR(10)+"Abort script")'
    select
    when result=1 then call visu_equi
    when result=2 then call controler_netlist
    when result=3 then call sauver_netlist
    otherwise c=0
    end
end
exit

visu_equi:
    'TITLE("Looking for nets"):UNMARK(-1)'
    do i=0 to nets
    if label.i ~= "LABEL_DÉJÀ_UTILISÉ" & label.i ~= "" then do
        do j=1 to objets
        if equi.j=i then 'MARK('j')'
        end
        'SELECT("Net 'label.i'"+CHR(10)+"Abort"+CHR(10)+"Continue"+CHR(10)+"Save netlist"+CHR(10)+"Check netlist")'
        if result <= 1 then return
        if result = 3 then do
        call sauver_netlist
        exit
        end
        if result = 4 then do
        call controler_netlist
        leave
        end
        'UNMARK(-1)'
    end
    end
    return

test_ligne: procedure expose equi.
    parse arg x0,y0,n,nbo
    o=1
    do until o=0
    'X=FINDOBJ('o',2,'x0','y0')'; o=result
    if o>0 then do
        'IF(TEST(X),"",MARK(X):COORDS(X))'
        if result~="" then do
        parse var result x1','y1','x2','y2
        equi.o=n
        if x0=x1 & y0=y1 then call test_ligne(x2,y2,n,nbo)
        else call test_ligne(x1,y1,n,nbo)
        end
        if o=nbo then o=0
        else o=o+1
    end
    end
    return

changer_labels: procedure expose equi. objets label.
    parse arg o1,o2
    if datatype(equi.o2,'w') then do
    e=equi.o2
    label.e=""
    do i=1 to objets
        if equi.i=e then equi.i=equi.o1
    end
    return o1
    end
    else do
    e=equi.o1
    label.e=""
    do i=1 to objets
        if equi.i=e then equi.i=equi.o2
    end
    return o2
    end
    return

test_jonction: procedure expose equi.
    parse arg xj,yj,n,objets
    obj=1
    do while obj>0
    'X=ABS(FINDLINE('obj','xj','yj'))'; obj=result
    if obj>0 then do
        if equi.obj=n then return 1
        if obj=objets then return 0
        obj=obj+1
    end
    end
    return 0

controler_netlist:
    'TITLE("Checking netlist...")'
    i=1
    do while i>0
    'O=FINDOBJ('i',1,-1,-1)'; i=result
    if i>0 then do
        'PARTNAME(O)'
        if result~="ALIMENTATION" & result ~="MASSE" then do
        'IF(GETREF(O),READTEXT(GETREF(O)),PARTNAME(O)+"?")'
        ligne=translate(result,"_"," ")||' '
        'DEVPINS(O)'; j=result
        do k=1 to j
            l=connexion_broche(i,k)
            if l>0 then do
            net=equi.l
            ligne=ligne||label.net||' '
            end
            else ligne=ligne||"-1"||' '
        end
        'IF(GETVAL(O),READTEXT(GETVAL(O)),PARTNAME(O))'
        ligne=ligne||result
        'UNMARK(-1):MARK(O):SELECT("'ligne'"+CHR(10)+"Continue"+CHR(10)+"Abort")'
        if result~=1 then return
        end
        if i=objets then leave
        i=i+1
    end
    end
    'TITLE("")'
return

sauver_netlist:
    'TITLE(""):REQFILE("Netlist file to create","Spice")'
    fichier=result
    if fichier="" then return
    'TITLE("Saving netlist...")'
    if ~open(file, fichier, 'W') then return
    'FILEPART("")'
    writeln(file,result)
    'DATE(1)+" à "+TIME(1)'
    writeln(file,"* Created by AmiCAD, on "||result||" *")
    do i=1 to objets
    'O=FINDOBJ('i',1,-1,-1)'; i=result
    if result>0 then do
        'PARTNAME(O)'
        if result~="POWER SUPPLY" & result ~="GROUND" then do
        'IF(GETREF(O),READTEXT(GETREF(O)),PARTNAME(O)+"?")'
        ligne=translate(result,"_"," ")||' '
        'DEVPINS(O)'; j=result
        do k=1 to j
            l=connexion_broche(i,k)
            if l>0 then do
            net=equi.l
            ligne=ligne||label.net||' '
            end
            else ligne=ligne||"-1"||' '
        end
        'IF(GETVAL(O),READTEXT(GETVAL(O)),PARTNAME(O))'
        ligne=ligne||result
        call writeln(file, ligne)
        end
    end
    else leave i
    end
    analyse=""
    do i=1 to objets
    'FINDOBJ('i',4,-1,-1)'; i=result
    if i>0 then do
        'READTEXT('i')'; t=result
        if left(t,10)=".ANALYSE: " then do
        analyse=right(t,length(t)-10)
        end
    end
    else leave
    end
    if analyse="" then do
    'SELECT("Type of''analyse to do"+CHR(10)+"AC"+CHR(10)+"DC"+CHR(10)+"Transient")'
    select
        when result=1 then do
        'SELECT("Type of variation"+CHR(10)+"Decade"+CHR(10)+"Octave"+CHR(10)+"Linear")'
        select
            when result=1 then do
            f="DEC "; v="by decade"
            end
            when result=2 then do
            f="OCT "; v="by octave"
            end
            when result=3 then do
            f="LIN "; v="de test"
            end
            otherwise do
            close(file)
            return
            end
        end
        'ASK("Number of points 'v'?")'
        f=f||result
        'ASK("What''s the begining frequency?")'
        f=f||" "||result
        'ASK("What''s the ending frequency?")'
        analyse="AC "||f||' '||result
        end
        when result=2 then do
        'ASK("What''s the source name to be swept?")'
        f=result
        'ASK("What''s the start value?")'
        f=f||' '||result
        'ASK("What''s the ending value?")'
        f=f||' '||result
        'ASK("What''s the increment value?")'
        analyse="DC "||f||' '||result
        end
        when result=3 then do
        'ASK("Time of simulation?")'; temps=result
        'ASK("Simulation step?")'; pas=result
        'ASK("Time to begin simulation?")'; d=result
        analyse="tran "||pas||" "||temps||" "||d
        end
        otherwise
        return
    end
    end
    if analyse~="" then writeln(file,"."||analyse)
    writeln(file,".END")
    close(file)
    'MESSAGE("Saving ended"):TITLE("")'
return

connexion_broche: procedure
    parse arg objet,broche
    'PINCOL(O='objet',B='broche')'; xj=result
    'PINLINE(O,B)'; yj=result
    'FINDOBJ(1,2,'xj','yj')'; xl=result
    if xl>0 then return xl
    'FINDLINE(1,'xj','yj')'; xl=result
    if xl<=0 then return 0
    'FINDOBJ(1,7,'xj','yj')'
    if result>0 then return xl
    return 0

syntax:
erreur=RC
'MESSAGE("Script SaveNets.AmiCAD:"+CHR(10)+"Syntax error"+CHR(10)+"in line 'SIGL'"+CHR(10)+"'errortext(erreur)'")'
exit

error:
'MESSAGE("Script SaveNets.AmiCAD:"+CHR(10)+"Erreur in line 'SIGL'")'
exit